home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / basic / qbfaqr01.zip / VIDTYPE.BAS < prev    next >
BASIC Source File  |  1992-08-10  |  2KB  |  86 lines
  1. ' VidType.BAS - determines video adapter type and returns with an
  2. '               errorlevel to DOS
  3. '               (see function for values)
  4. '
  5. ' by Brent Ashley - no copyright - do whatcha like withit
  6. '
  7. DECLARE SUB ExitLevel ALIAS "_exit" (BYVAL ErrLvl%)
  8. DECLARE FUNCTION VidType% ()
  9. DEFINT A-Z
  10. '$INCLUDE: 'qb.bi'
  11.  
  12. PRINT : PRINT "This computer is equipped with ";
  13. SELECT CASE VidType
  14.   CASE 1
  15.     PRINT "a Monochrome Text ";
  16.   CASE 2
  17.     PRINT "a Hercules ";
  18.   CASE 3
  19.     PRINT "a CGA ";
  20.   CASE 4
  21.     PRINT "an EGA ";
  22.   CASE 5
  23.     PRINT "a VGA ";
  24. END SELECT
  25. PRINT "adapter."
  26. ExitLevel VidType
  27.  
  28. FUNCTION VidType%
  29.   ' ** DETERMINE DISPLAY ADAPTER **
  30.   ' This function returns the following values for the different
  31.   ' display adapters:
  32.   '
  33.   ' VGA: 5
  34.   ' EGA: 4
  35.   ' CGA: 3
  36.   ' HGC: 2 (Hercules)
  37.   ' MDA: 1
  38.   '
  39.   ' Uses CALL Interrupt - set up Registers TYPEd variable
  40.   DIM Regs AS RegType
  41.  
  42.   ' force variables local
  43.   STATIC EgaInfo, InitialMode, i, Ticks
  44.  
  45.   ' If all else fails, it's the old MDA
  46.   VidType% = 1 ' MDA
  47.  
  48.   ' Check for VGA - INT 10h svc 1B will return 1B in AL if VGA
  49.   Regs.AX = &H1B00
  50.   CALL Interrupt(&H10, Regs, Regs)
  51.   IF ((Regs.AX AND &HFF) = &H1B) THEN
  52.     VidType% = 5 ' VGA
  53.   ELSE
  54.     ' Check for EGA - EGA Info byte at 0000:0487 will have bits set
  55.     DEF SEG = 0
  56.     EgaInfo = PEEK(&H487)
  57.     DEF SEG
  58.     IF EgaInfo <> 0 THEN
  59.       VidType% = 4 ' EGA
  60.     ELSE
  61.       ' Check for CGA - if initial display mode was not 80x25 MONO
  62.       CALL Interrupt(&H11, Regs, Regs) ' get equipment list
  63.       InitialMode = (Regs.AX MOD 256) AND &H30 ' mask vid bits
  64.       IF InitialMode <> &H30 THEN
  65.         VidType% = 3 ' CGA
  66.       ELSE
  67.         ' Check for HGC - bit 7 of port 3BAh is 1 during vert retrace
  68.         ' we loop through two timer-tick changes (> 1/18th sec)
  69.         ' to give it enough time to set.
  70.         DEF SEG = 0
  71.         FOR i = 1 TO 2
  72.           Ticks = PEEK(&H46D) AND 1
  73.           DO WHILE Ticks = (PEEK(&H46D) AND 1)
  74.             IF INP(&H3BA) AND &H80 THEN
  75.               VidType% = 2 ' HGC
  76.               EXIT FOR
  77.             END IF ' hgc
  78.           LOOP
  79.         NEXT
  80.         DEF SEG
  81.       END IF  ' cga
  82.     END IF  ' ega
  83.   END IF  ' vga
  84.   ' done
  85. END FUNCTION
  86.